perm filename FORMAT.SAI[PNT,HE]1 blob sn#478451 filedate 1979-09-28 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00003 00003	! display: cvxs,cvxv,cvxr,cvxt,cvxf,cvxm,cvxp
C00007 00004	! cvx,cvsym,cvssym,cvexpr
C00010 ENDMK
C⊗;
ENTRY;
BEGIN "FORMAT"
DEFINE $FORMAT=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;

INTEGER ARRAY W[1:10],D[1:10];
INTEGER STPTR;

PROCEDURE SFORMAT(INTEGER WIDTH,DIGITS);
BEGIN
	STPTR←STPTR+1;
	GETFORMAT(W[STPTR],D[STPTR]);
	SETFORMAT(WIDTH,DIGITS);
END;

PROCEDURE GFORMAT;
BEGIN
	SETFORMAT(W[STPTR],D[STPTR]);
	STPTR←STPTR-1;
END;
! display: cvxs,cvxv,cvxr,cvxt,cvxf,cvxm,cvxp;

SIMPLE STRING PROCEDURE CVXS(REAL R; INTEGER MODE(TABLE_D));
	BEGIN
	STRING S1;
	IF MODE=TABLE_D THEN SFORMAT(0,2) ELSE SFORMAT(0,3);
	S1←CVF(R);
	GFORMAT;
	RETURN(SCAN(S1,$BSKTAB,$BRCHR));	! to cancel the spaces;
	END;

	! returns a string with the rotation part;

SIMPLE STRING PROCEDURE CVXR(REAL ARRAY XF;INTEGER MODE(TABLE_D));
	BEGIN
	REAL W,PH,TH; STRING RS,SCA;
	STRING BEG,MID,EN;
	SIMPLE STRING PROCEDURE ROTFORM(STRING AXIS;REAL W);
		RETURN(BEG&AXIS&MID&CVF(W)&EN);

	IF MODE=TABLE_D
	THEN	BEGIN BEG←"("; MID←","; EN←")" END
	ELSE	BEGIN BEG←"ROT("; MID←"HAT,"; EN←"*DEG)" END;

	TH←XF[4];PH←XF[5];W←XF[6]; RS←SCA←NULL;
	SFORMAT(0,1);
	IF ABS(TH)>$EPS THEN 
		BEGIN RS←RS&ROTFORM("Z",TH); SCA←"*"; END;
	IF ABS(PH)>$EPS THEN
		BEGIN RS←RS&SCA&ROTFORM("Y",PH); SCA←"*"; END;
	IF ABS(W)>$EPS THEN
		BEGIN RS←RS&SCA&ROTFORM("Z",W); SCA←"*"; END;
	IF LENGTH(SCA)=0 THEN RS←"NILROT";
	GFORMAT;
	RETURN(SCAN(RS,$BSKTAB,$BRCHR));
	END;

	! returns a string with the vector part for frame assignments;

SIMPLE  STRING PROCEDURE CVXV(REAL X,Y,Z;INTEGER MODE(TABLE_D));
	BEGIN
	STRING S,VECTOR,INCH;
	IF MODE=FILE_D THEN
		BEGIN VECTOR←"VECTOR"; INCH←"*INCHES"; SFORMAT(0,3); END
	ELSE BEGIN VECTOR←INCH←NULL; SFORMAT(0,2); END;
	IF ABS(X)<$EPS AND ABS(Y)<$EPS AND ABS(Z)<$EPS
	   THEN S←"NILVECT"&INCH
	   ELSE S←" "&VECTOR&"("&CVF(X)&","&CVF(Y)&","&CVF(Z)
			&")"&INCH;
	GFORMAT;
	RETURN(SCAN(S,$BSKTAB,$BRCHR));
	END;

SIMPLE STRING PROCEDURE CVTR(REAL ARRAY XF;INTEGER MODE(TABLE_D));
	BEGIN				
	STRING S;
	S←"("&CVXR(XF,MODE)&","&CVXV(XF[1],XF[2],XF[3],MODE)&")";
	RETURN(SCAN(S,$BSKTAB,$BRCHR));
	END;

SIMPLE STRING PROCEDURE CVXT(REAL ARRAY XF; INTEGER MODE(TABLE_D));
	IF MODE=TABLE_D THEN RETURN(CVTR(XF,MODE))
		ELSE RETURN("TRANS"&CVTR(XF,MODE));

SIMPLE STRING PROCEDURE CVXF(REAL ARRAY XF; INTEGER MODE(TABLE_D));
	IF MODE=TABLE_D THEN RETURN(CVTR(XF,MODE))
		ELSE RETURN("FRAME"&CVTR(XF,MODE));

SIMPLE STRING PROCEDURE CVXM(STRING S; INTEGER MODE(TABLE_D));
	BEGIN INTEGER BRCHAR; STRING S1,S2;
	S1←"⊂"&SCAN(S,$RBTAB,BRCHAR)&"⊃";
	IF MODE≠TABLE_D THEN RETURN(S1);
	S2←SCAN(S1,$CRTAB,BRCHAR);
	WHILE S1 DO S2←S2&CRLF&"   "&SCAN(S1,$CRTAB,BRCHAR);
	RETURN(S2);
	END;

SIMPLE STRING PROCEDURE CVXP(STRING S; INTEGER MODE(TABLE_D));
	RETURN(S);

! cvx,cvsym,cvssym,cvexpr;
STRING PROCEDURE CVX(RANY T; INTEGER TYPE,MODE(TABLE_D));
	BEGIN "cvx"
	STRING S;
	CASE TYPE OF
		BEGIN
		[#SC] S←CVXS(SCALAR:VALUE[T],MODE);
		[#VT] S←CVXV(VECTOR:XC[T],VECTOR:YC[T],VECTOR:ZC[T],MODE);
		[#RT] S←CVXR(ROT:XF[T],MODE);
		[#TR] S←CVXT(TRANS:XF[T],MODE);
		[#FR] S←CVXF(FRAME:XF[T],MODE);
		[#MC] S←CVXM(MACRO:BODY[T],MODE);
		[#PR] S←CVXP(PROC:BODY[T],MODE)
		END;
	RETURN(S);
	END "cvx";

INTERNAL STRING PROCEDURE CVEXPR(RPTR(EXPR$)EX; INTEGER MODE(TABLE_D));
	RETURN(CVX($EVALEXP(EX),EXPR$:TYPE[EX],MODE));

INTERNAL STRING PROCEDURE CVSYM(RPTR(SYMBOL)SYM; INTEGER MODE(TABLE_D));
! only gives the data part ;
CASE SYMBOL:ACCESS[SYM] OF
	BEGIN
	[#PROCEDURE]
	    RETURN(CVX(SYMBOL:OBJECT[SYM],#PR,MODE));
	[#SIMPLE][#ARRAY_ELEMENT]
	    IF SYMBOL:TYPE[SYM]=#MC OR ($ELFABORTED AND (MODE=FILE_D))
		THEN
	    RETURN(CVX(SYMBOL:OBJECT[SYM],SYMBOL:TYPE[SYM],MODE))
		ELSE
	    IF SYMBOL:TYPE[SYM]=#EV THEN RETURN ("")
		ELSE
	    RETURN(CVX($EVAL11(SYM),SYMBOL:TYPE[SYM],MODE));
	[#ARRAY]
	    ERROR("CVSYM ERROR: cannot handle ARRAYS")
	END;
	    
INTERNAL STRING PROCEDURE CVSSYM(RPTR(SYMBOL)SYM; INTEGER MODE(TABLE_D));
! gives symbol and appends data part ;
CASE SYMBOL:ACCESS[SYM] OF
    BEGIN
    [#SIMPLE][#PROCEDURE][#ARRAY_ELEMENT]
	BEGIN
	STRING HEAD;
	IF #SC≤SYMBOL:TYPE[SYM]≤#EV
	THEN HEAD←" "&SYMBOL:PNAME[SYM]&" "
	ELSE IF SYMBOL:TYPE[SYM]=#MC
	    THEN HEAD←" "&MACRO:HEAD[SYMBOL:OBJECT[SYM]]&(IF MODE=TABLE_D THEN
		" " ELSE " = ")
	    ELSE HEAD←" ";	! the head of the procedure is in body;
	RETURN(HEAD&CVSYM(SYM,MODE))
	END;
    [#ARRAY] ERROR("CVSSYM ERROR: cannot handle ARRAYS")
    END;

END "FORMAT"